home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / windows / tbag32.zip / TRAFFICM.PAS < prev   
Pascal/Delphi Source File  |  1997-03-06  |  5KB  |  188 lines
  1. unit TrafficM;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Tbag, StdCtrls, ComCtrls, ExtCtrls, Buttons;
  8.  
  9. type
  10.   TfrmTrafficMain = class(TForm)
  11.     Bag1: TBag32;
  12.     Panel2: TPanel;
  13.     L1: TShape;
  14.     L2: TShape;
  15.     L3: TShape;
  16.     Panel3: TPanel;
  17.     L4: TShape;
  18.     L5: TShape;
  19.     L6: TShape;
  20.     SpeedButton1: TSpeedButton;
  21.     btnDisplay: TButton;
  22.     Timer1: TTimer;
  23.     btnStart: TButton;
  24.     pnlTraffic: TPanel;
  25.     lbTraffic: TListBox;
  26.     edTraffic: TEdit;
  27.     btnEdit: TButton;
  28.     btnAdd: TButton;
  29.     btnDel: TButton;
  30.     procedure FormShow(Sender: TObject);
  31.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  32.     procedure SpeedButton1Click(Sender: TObject);
  33.     procedure lbTrafficClick(Sender: TObject);
  34.     procedure Timer1Timer(Sender: TObject);
  35.     procedure btnDisplayClick(Sender: TObject);
  36.     procedure btnStartClick(Sender: TObject);
  37.     procedure btnAddClick(Sender: TObject);
  38.     procedure btnDelClick(Sender: TObject);
  39.     procedure btnEditClick(Sender: TObject);
  40.   private
  41.     Nodes: array[0..20] of TTreeNode;
  42.     KeyList: TStringList;
  43.   public
  44.     { Public declarations }
  45.   end;
  46.  
  47. var
  48.   frmTrafficMain: TfrmTrafficMain;
  49.  
  50. implementation
  51.  
  52. {$R *.DFM}
  53.  
  54. uses About3K;
  55.  
  56. procedure TfrmTrafficMain.FormShow(Sender: TObject);
  57. begin
  58.   with Bag1 do begin
  59.     GetFormPlace('FORMPLACE',Self);
  60.     GetStrings('TRAFFIC_LIST',lbTraffic.Items);
  61.     lbTraffic.ItemIndex := GetInteger('LIST_INDEX',-1);
  62.     lbTrafficClick(lbTraffic);
  63.     btnDisplay.Tag := GetInteger('BTN_DISPLAY',0);
  64.     btnDisplayClick(nil);
  65.     Timer1.Enabled := GetBoolean('TIMER',False);
  66.     btnStartClick(nil);
  67.   end;
  68. end;
  69.  
  70. procedure TfrmTrafficMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  71. begin
  72.   with Bag1 do begin
  73.     SetFormPlace('FORMPLACE',Self);
  74.     SetStrings('TRAFFIC_LIST',lbTraffic.Items);
  75.     SetInteger('LIST_INDEX',lbTraffic.ItemIndex);
  76.     SetInteger('BTN_DISPLAY',btnDisplay.Tag);
  77.     SetBoolean('TIMER',Timer1.Enabled);
  78.   end;
  79. end;
  80.  
  81. procedure TfrmTrafficMain.SpeedButton1Click(Sender: TObject);
  82. begin
  83.   with TfrmAbout3K.Construct('About Traffic (TBag32 demo)') do try
  84.     ShowModal;
  85.   finally
  86.     Free;
  87.   end;
  88. end;
  89.  
  90. procedure TfrmTrafficMain.lbTrafficClick(Sender: TObject);
  91. var
  92.   s: string;
  93.   p,ix,ix2: integer;
  94.   c: longint;
  95. begin
  96.   if lbTraffic.ItemIndex < 0 then exit;
  97.   with lbTraffic do s := Items[ItemIndex];
  98.   edTraffic.Text := s;
  99.   p := Pos(' ',s);
  100.   if p > 1 then Timer1.Interval := StrToInt(Copy(s,1,p-1));
  101.   for ix := 1 to 6 do begin
  102.     p := Pos('cl',s);
  103.     if p = 0 then Break;
  104.     s := Copy(s,p,255);
  105.     p := Length(s)+1;
  106.     for ix2 := 1 to Length(s) do begin
  107.       if s[ix2] in [',',' '] then begin
  108.         p := ix2;
  109.         Break;
  110.       end;
  111.     end;
  112.     if IdentToColor(Copy(s,1,p-1),c) then
  113.       with FindComponent('L'+IntToStr(ix)) as TShape do
  114.         Brush.Color := TColor(c);
  115.     s := Copy(s,p+1,255);
  116.   end;
  117. end;
  118.  
  119. procedure TfrmTrafficMain.Timer1Timer(Sender: TObject);
  120. begin
  121.   with lbTraffic do
  122.     ItemIndex := (ItemIndex + 1) mod Items.Count;
  123.   lbTrafficClick(lbTraffic);
  124. end;
  125.  
  126. procedure TfrmTrafficMain.btnDisplayClick(Sender: TObject);
  127. const
  128.   caps: array[0..1] of string = ('Show','Hide');
  129. begin
  130.   with btnDisplay do begin
  131.     if Sender <> nil then Tag := (Tag + 1) mod 2;
  132.     pnlTraffic.Visible := (Tag = 1);
  133.     Caption := caps[Tag]+' Traffic &List';
  134.   end;
  135. end;
  136.  
  137. procedure TfrmTrafficMain.btnStartClick(Sender: TObject);
  138. const
  139.   caps: array[boolean] of string = ('&Start','&Stop');
  140. begin
  141.   with btnStart do begin
  142.     if Sender <> nil then with Timer1 do Enabled := not Enabled;
  143.     Caption := caps[Timer1.Enabled];
  144.   end;
  145.   btnEdit.Enabled := not Timer1.Enabled;
  146.   btnAdd.Enabled := not Timer1.Enabled;
  147.   btnDel.Enabled := not Timer1.Enabled;
  148.   edTraffic.Visible := not Timer1.Enabled;
  149. end;
  150.  
  151. procedure TfrmTrafficMain.btnAddClick(Sender: TObject);
  152. begin
  153.   with lbTraffic do begin
  154.     if (ItemIndex >=0) and (ItemIndex < Items.Count-1)
  155.       then Items.Insert(ItemIndex+1,edTraffic.Text)
  156.       else Items.Add(edTraffic.Text);
  157.     ItemIndex := Items.IndexOf(edTraffic.Text);
  158.     lbTrafficClick(lbTraffic);
  159.   end;
  160. end;
  161.  
  162. procedure TfrmTrafficMain.btnDelClick(Sender: TObject);
  163. var
  164.   ix: integer;
  165. begin
  166.   with lbTraffic do begin
  167.    ix := ItemIndex;
  168.    if ix >=0 then Items.Delete(ix);
  169.    if ix >= Items.Count then dec(ix);
  170.    ItemIndex := ix;
  171.    lbTrafficClick(lbTraffic);
  172.   end;
  173. end;
  174.  
  175. procedure TfrmTrafficMain.btnEditClick(Sender: TObject);
  176. var
  177.   ix: integer;
  178. begin
  179.   with lbTraffic do begin
  180.     ix := ItemIndex;
  181.     if ItemIndex >=0 then Items[ItemIndex] := edTraffic.Text;
  182.     ItemIndex := ix;
  183.     lbTrafficClick(lbTraffic);
  184.   end;
  185. end;
  186.  
  187. end.
  188.